home *** CD-ROM | disk | FTP | other *** search
- PROGRAM ISTLA
-
- INTEGER SRCPTH(81),MTRPTH(81),CMTPTH(81),
- + MSYPTH(81),ATRPTH(81),CIPTH(81),
- + IODATR,STATUS,IODSRC,IODCMT,IODTRE,IODMSY,IODCI,
- + NERROR,NWARN
-
- INTEGER GETARG,OPEN,CREATE,YPARSE
- EXTERNAL ZINIT,GETARG,ZQUIT,CLOSE,OPEN,CREATE,ERROR,ZYXZIA,
- + ZYXOAS,ZYSOUT,ZYTOUT,YPARSE,ZMESS,REMARK
-
- CALL ZINIT
- CALL INISTR
- CALL INISYM
- CALL INITRE
-
- CALL ZMESS('ISTLA - Toolpack Static Analyser, Version 1..2',
- + 1)
-
- IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(SRCPTH,1)
- IF (GETARG(2,CMTPTH,81).EQ.-100) CALL NAMES(CMTPTH,2)
- IF (GETARG(3,MTRPTH,81).EQ.-100) CALL NAMES(MTRPTH,3)
- IF (GETARG(4,MSYPTH,81).EQ.-100) CALL NAMES(MSYPTH,4)
- IF (GETARG(5,CIPTH,81).EQ.-100) CALL NAMES(CIPTH,5)
- IF (GETARG(6,ATRPTH,81).EQ.-100) CALL NAMES(ATRPTH,6)
-
- IODSRC=OPEN(SRCPTH,0)
- IF (IODSRC.EQ.-1) CALL ERROR('Can''t open source file')
- IODCMT=CREATE(CMTPTH,1)
- IF (IODCMT.EQ.-1) CALL ERROR('Can''t create comment file')
- IODCI=CREATE(CIPTH,1)
- IF (IODCI.EQ.-1) CALL ERROR('Can''t create comment index')
- IODATR=CREATE(ATRPTH,1)
- IF (IODATR.EQ.-1) CALL ERROR('Can''t create attribute file')
-
- IF (YPARSE(IODSRC,IODCMT,-1,IODCI,NERROR,NWARN).EQ.0) THEN
- IF (NERROR+NWARN.EQ.0) THEN
- STATUS=-2
- ELSE IF (NERROR.EQ.0) THEN
- STATUS=-1002
- ELSE
- CALL ZCHOUT('[ISTLA Terminated, ',1)
- CALL ZPTINT(NERROR,1,1)
- CALL ZCHOUT(' parse er'//'ror',1)
- IF (NERROR.GT.1) CALL PUTCH(115,1)
- CALL ZMESS(']',1)
- CALL ZQUIT(-1)
- END IF
- ELSE
- CALL ERROR('[ISTLA Fatal Error -- Terminated]')
- END IF
-
- CALL ZYXZIA
-
- CALL ZMESS('[Parsing complete, analysis beginning]',1)
-
- CALL ANALYS(.TRUE.,NERROR,NWARN)
-
- IF (NERROR.GT.0) THEN
- CALL REMARK('[ISTLA Terminated, Errors detected]')
- CALL ZQUIT(-1)
- ELSE
- IODTRE=CREATE(MTRPTH,1)
- IF (IODTRE.EQ.-1) CALL ERROR('Can''t create extended tree')
- CALL ZYTOUT(IODTRE)
- IODMSY=CREATE(MSYPTH,1)
- IF (IODMSY.EQ.-1)
- + CALL ERROR('Can''t create extended symbol table')
- CALL ZYSOUT(IODMSY)
- CALL ZYXOAS(IODATR)
- IF (NWARN.GT.0) THEN
- CALL REMARK('[ISTLA Terminated, Warnings produced]')
- CALL ZQUIT(-1002)
- ELSE
- CALL REMARK('[ISTLA Normal Termination]')
- CALL ZQUIT(-2)
- END IF
- END IF
-
- END
- C ----------------------------------------------------------------------
- C
- C N A M E S - Prompt user for filenames
- C
-
- SUBROUTINE NAMES(PATH,NUMBER)
- INTEGER PATH(81),NUMBER
-
- INTEGER PROMPT(23,6),I
-
- SAVE PROMPT
-
- INTEGER ZGTCMD
- EXTERNAL ZGTCMD,ZPRMPT,ERROR
-
- C "Input source file: "
- C "Output comment file: "
- C "Output parse tree: "
- C "Output symbol table: "
- C "Output comment index: "
- C "Attribute file: "
-
- DATA (PROMPT(I,1),I=1,20)/73,110,112,117,116,32,115,
- +111,117,114,99,101,32,102,105,108,101,58,32,129/,
- + (PROMPT(I,2),I=1,22)/79,117,116,112,117,116,32,
- +99,111,109,109,101,110,116,32,102,105,108,101,
- +58,32,129/,
- + (PROMPT(I,3),I=1,20)/79,117,116,112,117,116,
- +32,112,97,114,115,101,32,116,114,101,101,
- +58,32,129/,
- + (PROMPT(I,4),I=1,22)/79,117,116,112,117,116,
- +32,115,121,109,98,111,108,32,116,97,98,
- +108,101,58,32,129/,
- + (PROMPT(I,5),I=1,23)/79,117,116,112,117,116,32,
- +99,111,109,109,101,110,116,32,105,110,100,101,120,
- +58,32,129/,
- + (PROMPT(I,6),I=1,17)/65,116,116,114,105,98,117,
- +116,101,32,102,105,108,101,58,32,129/
-
- CALL ZPRMPT(PROMPT(1,NUMBER))
- IF (ZGTCMD(PATH,0).EQ.-1)
- + CALL ERROR('ZGTCMD returned Error status')
-
- END
-